home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Developer Helper 1: Phil & Dave's Excellent CD
/
Excellent CD HFS.raw
/
Moof
/
Goodies
/
HyperCard Goodies
/
HyperCard Dev. ToolKit
/
Video.Drivers
/
PanasonicTQ2024F.p
< prev
next >
Wrap
Text File
|
1987-08-17
|
8KB
|
329 lines
{$R-}
{$D+}
(*
PanasonicTQ2024F -- a HyperCard user-defined command to drive a
Panasonic TQ-2024F write-once laserdisc player.
©Apple Computer, Inc. 1987
All Rights Reserved.
To compile and link this file using Macintosh Programmer's Workshop
(HyperXCmd.p and XCmdGlue.inc must be accessible).
pascal -w PanasonicTQ2024F.p
link -m ENTRYPOINT -o HyperCommands -rt XCMD=11 -sn Main=PanasonicTQ2024F ∂
PanasonicTQ2024F.p.o "{MPW}"Libraries:interface.o
then use ResEdit to copy the resulting XCMD from HyperCommands
and paste it into the Home stack, or your own stack.
(XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
*)
{$S PanasonicTQ2024F } { Segment name must be the same as the command name. }
UNIT DummyUnit;
INTERFACE
USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
IMPLEMENTATION
TYPE Str19 = String[19];
Str31 = String[31];
PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr); FORWARD;
PROCEDURE EntryPoint(paramPtr: XCmdPtr);
{ entry point cannot have local procs, but forward routines can }
BEGIN
PanasonicTQ2024F(paramPtr);
END;
PROCEDURE PanasonicTQ2024F(paramPtr: XCmdPtr);
VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
tempStr: Str255;
refNum: INTEGER;
err: INTEGER;
params: ARRAY[1..32] OF Str19;
{$I XCmdGlue.inc }
PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
BEGIN
paramPtr^.returnValue := PasToZero(errMsg);
EXIT(PanasonicTQ2024F);
END;
PROCEDURE OpenSerial;
VAR handShake: SerShk;
baudRate: INTEGER;
BEGIN
baudRate := 9600;
{ for now, use modem port so we don't mess with AppleTalk }
err := FSOpen('.AOUT',0,refNum);
IF err = 0 THEN
BEGIN
WITH handShake DO
BEGIN
fXon := 1;
fCTS := 1;
xon := CHR(17);
xoff := CHR(19);
errs := 0;
evts := 0;
fInx := 0;
END;
err := SerHShake(refNum,handShake);
IF err = 0 THEN
err := Control(refNum,13,@baudRate);
END;
END;
PROCEDURE CloseSerial;
BEGIN
err := FSClose(refNum);
END;
PROCEDURE SendCommand(cmd: Str255);
VAR count: LongInt;
BEGIN
count := Length(cmd) + 2;
cmd[Length(cmd) + 1] := CHR(3); { control-c }
cmd[0] := CHR(2); { control-B }
{ Is overwriting the length byte a dangerous thing? }
err := FSWrite(refNum, count, @cmd);
END;
FUNCTION Concat(str1, str2, str3: Str255): Str255;
VAR result: Str255;
resultLen: INTEGER;
charNum: INTEGER;
BEGIN
result := '';
resultLen := 0;
FOR charNum := 1 TO Length(str1) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str1[charNum];
END;
FOR charNum := 1 TO Length(str2) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str2[charNum];
END;
FOR charNum := 1 TO Length(str3) DO
BEGIN
resultLen := resultLen + 1;
result[resultLen] := str3[charNum];
END;
result[0] := CHR(resultLen);
Concat := result;
END;
PROCEDURE GetMessage;
VAR paramNum, charNum: INTEGER;
msgChar: CHAR;
BEGIN
{ convert params to pascal strings }
FOR paramNum := 1 TO paramPtr^.paramCount DO
BEGIN
tempStr := params[paramNum];
ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
{ force all chars to lower case }
FOR charNum := 1 TO Length(tempStr) DO
BEGIN
msgChar := tempStr[charNum];
IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
END;
params[paramNum] := tempStr;
END;
END;
FUNCTION Contains(target: Str255): BOOLEAN;
VAR offset: INTEGER;
FUNCTION Match(which: INTEGER): BOOLEAN;
VAR index: INTEGER;
BEGIN
Match := TRUE;
FOR index := 1 TO Length(target) DO
IF index > Length(params[which]) THEN
BEGIN
Match := FALSE; { ran off the end }
EXIT(Match);
END
ELSE IF target[index] <> params[which][index] THEN
BEGIN
Match := FALSE; { hit a wrong char }
EXIT(Match);
END;
END;
BEGIN
Contains := FALSE;
FOR offset := 1 TO paramPtr^.paramCount DO
IF Match(offset) THEN
BEGIN
Contains := TRUE;
EXIT(Contains);
END;
END;
FUNCTION GetInteger: Str255;
{ get an integer in Pioneer format }
VAR which, digitLoc, charVal: INTEGER;
BEGIN
FOR which := 1 TO paramPtr^.paramCount DO
BEGIN
charVal := ORD(params[which][1]);
IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
BEGIN
GetInteger := params[which]; {that whole parameter}
exit(GetInteger);
END;
END;
GetInteger := ''; { just in case }
END;
BEGIN
OpenSerial;
IF err <> 0 THEN
BEGIN
SysBeep(1);
Fail('Could not open serial port');
END;
GetMessage;
{ set flags }
reverseFlag := Contains('rev');
offFlag := Contains('off');
tillFlag := Contains('till');
IF Contains('init') THEN SendCommand('AC;ON0:')
ELSE IF Contains('stop') THEN SendCommand('TF')
ELSE IF Contains('eject') THEN SendCommand('EJ')
ELSE IF Contains('search') THEN SendCommand(Concat('SR', GetInteger, ':'))
ELSE IF Contains('step') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('TF') {step fwd}
ELSE SendCommand('TR') {step rev}
END
ELSE IF Contains('play') THEN
BEGIN
IF NOT tillFlag THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('PF') {play fwd}
ELSE SendCommand('PR'); {play rev}
END
ELSE
BEGIN
IF NOT reverseFlag
THEN SendCommand(Concat('PF', GetInteger, ':')) {play till fwd}
ELSE SendCommand(Concat('PR', GetInteger, ':')); {play till rev}
END;
END
ELSE IF Contains('slower') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('LR32:', GetInteger, ':'))
ELSE SendCommand(Concat('LF32:', GetInteger, ':'));
END
ELSE IF reverseFlag THEN SendCommand('LR32:')
ELSE SendCommand('LF32:')
END
ELSE IF Contains('slowest') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('LR64:', GetInteger, ':'))
ELSE SendCommand(Concat('LF64:', GetInteger, ':'));
END
ELSE IF reverseFlag THEN SendCommand('LR64:')
ELSE SendCommand('LF64:')
END
ELSE IF Contains('slow') THEN
IF NOT tillFlag THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('LF16:') {slow fwd}
ELSE SendCommand('LR16:') {slow rev}
END
ELSE
BEGIN
IF NOT reverseFlag THEN SendCommand(Concat('LF16:', GetInteger, ':')) {slow TILL fwd}
ELSE SendCommand(Concat('LR16:', GetInteger, ':')) {slow TILL rev}
END
ELSE IF Contains('faster') THEN
BEGIN
IF tillFlag THEN
BEGIN
IF reverseFlag THEN SendCommand(Concat('FR8:', GetInteger, ':'))
ELSE SendCommand(Concat('FF8:', GetInteger, ':'));
END
ELSE IF reverseFlag THEN SendCommand('FR8:')
ELSE SendCommand('FF8:')
END
ELSE IF Contains('fast') THEN
IF NOT tillFlag THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('FF3:') {fast fwd}
ELSE SendCommand('FR3:') {fast rev}
END
ELSE
BEGIN
IF NOT reverseFlag THEN SendCommand(Concat('FF3:', GetInteger, ':')) {fast TILL fwd}
ELSE SendCommand(Concat('FR3:', GetInteger, ':')) {fast TILL rev}
END
ELSE IF Contains('scan') THEN
BEGIN
IF NOT reverseFlag THEN SendCommand('FF10:') {scan fwd}
ELSE SendCommand('FR10:') {scan rev}
END
ELSE IF Contains('picture') THEN
BEGIN
IF NOT offFlag THEN SendCommand('VS') {picture on}
ELSE SendCommand('VR') {picture off}
END
ELSE IF Contains('frame') THEN
BEGIN
IF NOT offFlag THEN SendCommand('DS') {frame on}
ELSE SendCommand('DR') {frame off}
END
ELSE IF Contains('sound') THEN
BEGIN
IF Contains('1') THEN
IF NOT offFlag THEN SendCommand('A134:') {sound 1 on}
ELSE SendCommand('A10:') {sound 1 off}
ELSE IF Contains('2') THEN
IF NOT offFlag THEN SendCommand('A234:') {sound 2 on}
ELSE SendCommand('A20:') {sound 2 off}
ELSE
BEGIN
CloseSerial;
Fail('Unknown video sound channel');
END;
END
ELSE
BEGIN
CloseSerial;
SysBeep(1);
Fail('Unknown video command');
END;
CloseSerial;
END;
END.